perm filename BIGGET.FAI[NEW,LCS]1 blob sn#155902 filedate 1975-04-18 generic text, type T, neo UTF8
00100		TITLE	BIGGET
00200		ENTRY	BIGGET,MOVIT,SORT2,EXCH,EXTEN
00300		EXTERNAL .COMM.,XRN,KJY,PTR,NNP,MMV,RR4,AMOD
00400	
00500	  K←15↔J←14↔ M←2↔ R2←5↔ X←6↔ L←4↔ R←7↔ A←11↔RY←3↔RZ←13↔JJ2←12
00600		DEFINE FIXX(N)
00700	<	JUMPGE	N,.+5
00800		MOVNS	N
00900		FIX 	N,233000    
01000		MOVNS	N
01100		CAIA
01200		FIX	N,233000 >	; TO FIX IT LIKE 'IFIX' DOES.
01300	
01400	;  SEE JJUST ---
01500	
01600	BIGGET:	0		;CALL BIGGET
01700		SETZ	J,	;	J=0
01800		SETZ	K,	;	K=0
01900		SETZ	X,	; PTR IS LOC OF PWDS(1)
02000		MOVEI	M,PTR	;	DO 1 M=1,ITEM
02100	G1:	AOJ	X,
02200		MOVE	L,(M)	; XRN IS LOC OF RN(1)
02300		FIXX(L)
02400		MOVEI	R,XRN		;L=PWDS(M)
02500		ADDI	R,(L)		
02600	G9:	MOVE	A,2(R)		
02700		CAMLE	A,RR4+1
02800		JRST	G2	;9	IF(OUTLIM(R4,R5,RN(L+3)))GO TO 2
02900		CAMGE	A,RR4	;R4
03000		JRST	G2
03100	
03200		AOJ	J,
03300	;  IN LIMITS?
03400		MOVEI	A,MMV-1	;J=J+1
03500		ADDI	A,(J)
03600		MOVEI	0,(L)
03700		AOJ	K,		;K=K+1
03800		MOVEI	1,NNP-1
03900		ADDI	1,(K)		;NP(K)=L
04000		MOVEM	0,(1)
04100		ADDI	0,3		;N(J)=L+3
04200		MOVEM	0,(A)
04300	;  NP IS FOR USE IN JUSTIFY ROUTINE
04400	G2:	MOVE	RY,(R)	;2	IF(RY.LT.4)GO TO 1
04500		CAMGE	RY,[=4.0]
04600		JRST	GX
04700		CAMLE	RY,[=7.0]
04800		JRST	GX		;IF(RY.GT.7)GO TO 1
04900	;  TWO-ENDED ITEM?
05000		MOVE	RZ,-1(R)	;RZ=RN(L)
05100	;  WD CNT
05200		CAMN	RY,[=4.0]	;GO TO(4,5,6,7),IFIX(RY)-3
05300		JRST	G4
05400		CAMN	RY,[=5.0]
05500		JRST	G5
05600		CAMN	RY,[=6.0]
05700		JRST	G6
05800		CAMG	RZ,[=4.0]	;4	IF(RZ.GT.2)GO TO 5
05900		JRST	G5		; THERE IS A TRILL WIGGLE
06000		JRST	GX		;GO TO 1   -- NO WIGGLE (P7≠0)
06100	G4:	CAMG	RZ,[=2.0]	;7	IF(RZ.GT.3)GO TO 5
06200		JRST	GX
06300		JRST	G5		;GO TO 1
06400	G6:	CAMGE	RZ,[=8.0]	;6	IF(RZ.LT.8)GO TO 8
06500		JRST	G8
06600		MOVE	1,=9(R)		;IF(RN(L+10).LT.30)GO TO 8
06700		CAMGE	1,[=30.0]
06800		JRST	G8
06900		MOVE	A,7(R)	  ; IF(OUTLIM(R4,R5,RN(L+8)))GO TO 8
07000		CAMLE	A,RR4+1
07100		JRST	G8
07200		CAMGE	A,RR4
07300		JRST	G8
07400		AOJ	J,
07500	;  IN LIMITS?
07600		MOVEI	A,MMV-1	;J=J+1
07700		ADDI	A,(J)
07800		MOVEI	0,(L)		;J=J+1
07900		ADDI	0,=8		;N(J)=L+8
08000		MOVEM	0,(A)
08100	G8:	CAMGE	RZ,[=7.0]	;8	IF(RZ.LT.7)GO TO 5
08200		JRST 	G5
08300		MOVE	A,6(R)		;IF(RN(L+7))GO TO G8B
08400		JUMPL	A,G8B		; P7 IS NEG FOR TREMOLO
08500		MOVE	A,7(R)		;IF(RN(L+8).NE.0)GO TO G8B
08600		JUMPN	A,G8B
08700		CAMGE	RZ,[=8.0]
08800		JRST	G5		;IF(RZ.LT.8)GO TO G5
08900		MOVE	A,=9(R)		;IF(RN(L+10).EQ.0)GO TO G5
09000		JUMPE	A,G5		;PASSES NUMBER OVER BEAM.
09100	G8B:	MOVE	A,8(R)
09200		CAMLE	A,RR4+1
09300		JRST	G5
09400		CAMGE	A,RR4	;R4
09500		JRST	G5
09600	
09700		AOJ	J,		;J=J+1
09800	;  IN LIMITS?
09900		MOVEI	A,MMV-1	;J=J+1
10000		ADDI	A,(J)
10100		MOVEI	0,(L)
10200		ADDI	0,=9		;IF(OUTLIM(R4,R5,RN(L+9)))GO TO 5
10300		MOVEM	0,(A)		;N(J)=L+9
10400	G5:	MOVE	A,5(R)
10500		CAMLE	A,RR4+1
10600		JRST	GX
10700		CAMGE	A,RR4	;R4
10800		JRST	GX
10900	
11000		AOJ	J,
11100	;  IN LIMITS?
11200		MOVEI	A,MMV-1	;J=J+1
11300		ADDI	A,(J)
11400		MOVEI	0,(L)  ;5	IF(OUTLIM(R4,R5,RN(L+6)))GO TO 1
11500		ADDI	0,6		;N(J)=L+6
11600		MOVEM	0,(A)
11700	GX:	CAMGE	X,RR4+4		;1	CONTINUE
11800		AOJA	M,G1		;RR4+4 IS I (OR NUM OF ITEMS)
11900		MOVEM	J,KJY+1
12000		MOVEM	K,KJY
12100		JRA	16,(16)
12200	
12300	;	SUBROUTINE MOVIT
12400	;	DIMENSION N(500)
12500	;	COMMON/XRN/RN(4000)  /KJY/ DONT,J
12600	;	COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
12700	;	EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R9,RJQ(7))
12800	;	1,(R6,RJQ(4)),(N,RN(2500)),(R8,RJQ(6))
12900	MOVIT:	0		;RDIS=(R9-R8)/(R5-R4)
13000		MOVE	R,.COMM.+3
13100		FSBR	R,.COMM.+2
13200		MOVE	RY,RR4+1
13300		FSBR	RY,RR4
13400		FDVR	R,RY
13500		MOVEI	L,MMV      	;	DO 1 K=1,J
13600		SETZ	K,
13700		MOVE	0,.COMM.+3	; SET UP R9
13800	M1:	MOVE	X,L	       ;	L=N(K)
13900		MOVE	A,(X)
14000		MOVEI 	R2,XRN		;RA=RN(L)
14100		ADDI	R2,(A)
14200		MOVEI	RZ,(R2)
14300		MOVE	R2,-1(R2)
14400		CAMGE	R2,RR4		;IF(OUTLIM(R4,R5,RA))GO TO 1
14500		JRST 	MX
14600		CAMLE	R2,RR4+1
14700		JRST	MX
14800		JUMPE	0,M2		;IF(R9.NE.0)RA=(RA-R4)*RDIS
14900		FSBR	R2,RR4
15000		FMPR	R2,R 
15100	M2: 	FADR	R2,.COMM.+2	;	RN(L)=R8+RA
15200		MOVEM	R2,-1(RZ)
15300	MX:	AOJ	K,		;1	CONTINUE
15400		CAMGE	K,KJY+1
15500		AOJA	L,M1
15600		JRA	16,(16)
15700	
15800	SORT2:	0		;SUBROUTINE SORT2(RPOS,M)
15900		MOVEI	2,2	;DIMENSION RPOS(2,200)
16000	S3:	MOVE	6,2	;(K=L HERE)
16100		SETO	11,	;L=2
16200		HRRZI	3,@(16)	;3	J=-1
16300		MOVE	4,2	;RX=RPOS(1,L-1)
16400		SUBI	4,1	;L-1
16500		IMULI	4,2
16600		ADDI	4,(3)
16700		MOVE	5,-2(4)	;RX
16800	S2:	MOVE 	7,6	;	DO 2 K=L,M
16900	;;	LSH	7,1	;IF(RPOS(1,K).GE.RX)GO TO 2
17000		IMULI	7,2	;IF(RPOS(1,K).GE.RX)GO TO 2
17100		ADDI	7,(3)
17200		CAMG	5,-2(7)
17300		JRST	S1	; CONTINUE
17400		MOVE	5,-2(7)	;  RX=RPOS(1,K)
17500	;;C   WHY WERE ALL THE RX'S  JX ????? 9/6/73
17600		MOVE 	11,6	;J=K
17700	S1:	CAMGE	6,@1(16)	;2	CONTINUE
17800		AOJA	6,S2
17900		JUMPL	11,S4	;IF(J)GO TO 4
18000		MOVE	12,2	;K=L-1
18100		SOS	12
18200		IMULI	12,2	;(K*2)
18300		ADD	12,3	;CALL EXCH(RPOS(1,K),RPOS(1,J))
18400		MOVE	10,-2(12)
18500	;;	LSH	11,1		;MULTS BY 2 (LEFT SHIFT)
18600		IMULI	11,2
18700		ADD	11,3
18800		EXCH	10,-2(11)
18900		MOVEM	10,-2(12)
19000		MOVE	10,-1(12)	;CALL EXCH(RPOS(2,K),RPOS(2,J))
19100		EXCH	10,-1(11)
19200		MOVEM	10,-1(12)
19300	S4:	CAMGE	2,@1(16)	;4	L=L+1
19400		AOJA	2,S3		;IF(L.LE.M)GO TO 3
19500		JRA	16,2(16)	;END
19600	
19700	
19800	EXCH:	0	; SUBROUTINE EXCH(X,Y)
19900		MOVE	@(16)
20000		EXCH	0,@1(16)
20100		MOVEM	0,@(16)
20200		JRA	16,2(16)
20300	
20400	EXTEN:	0	;FUNCTION EXTEN(X)
20500		HRRM	16,.+2
20600		JSA	16,AMOD	;EXTEN=AMOD(X,1.)*10.
20700		JUMP 	@0
20800		JUMP	[=1.0]
20900		FMPR	[=10.0]
21000		JRA	16,1(16)
21100	
21200		END